Дан вектор P с координатами {x,y,z} и вектор G с координатами {x1,y1,z1} Их по очереди раскладывают по формуле P= a*x+ b*y + c*z и G= a*x1 + b*y1 + c*z1 соответственно, где P=G, необходимо найти коэффициенты a,b,c. При этом чтобы программа запрашивала условие и относительно этого условия выводила результат — Visual Basic(Бейсик)

disel
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
Attribute VB_Name = "Module1"
Global VvodIchX%, VvodIchY%, Vvod_1%, Vvod_2%
Global TimVal1!, TimVal2!
Global En As String * 2
  
  
' Всё связанное с методом Гаусса
Global MatrPoX%, MatrPoY%, DelitelStroki#, DelitelNull%
Global NowElmnt%, Matrix#(1 To 51, 1 To 50)
' Метод симплекса
Global Bazisniye%, Svobodniye%, MassivKombinacij%(1 To 50)
  
' Отправить текст в консоль на комментарий
'
Public Sub OutConsole(Text_To_Pute$)
 Form1.Text2.Text = Form1.Text2.Text + Text_To_Pute$ + En
End Sub
  
' Очистить консоль
'
Private Sub ClearConsole()
 Form1.Text2.Text = ""
End Sub
  
' Отправить текущую матрицу в консоль
'
Private Sub Matrix_To_Console()
 Dim mxx%, myy%, Matrica_Stroka$
  For myy% = 1 To MatrPoY%: Matrica_Stroka$ = "| "
   For mxx% = 1 To MatrPoX%
   Matrica_Stroka$ = Matrica_Stroka$ + LTrim$(Str$(TblXY#(mxx%, myy%))) + " "
  Next: Matrica_Stroka$ = Matrica_Stroka$ + "|"
  Call OutConsole(Matrica_Stroka$): Next
End Sub
  
' Взять значение с FlexGrid1
Private Function TblXY#(x_T%, y_T%)
 Dim GettingZn$
  GettingZn$ = Form1.MSFlexGrid1.TextMatrix(y_T%, x_T% - 1)
  If GettingZn$ <> "" Then TblXY# = Val(GettingZn$)
End Function
  
' Запись значения в FlexGrid1
Public Sub SetTblXY(x_T%, y_T%, Znachenie#)
  Form1.MSFlexGrid1.TextMatrix(y_T%, x_T% - 1) = Znachenie#
End Sub
  
' Очистка значения в FlexGrid1
Private Sub ClrTblXY(x_T%, y_T%)
  Form1.MSFlexGrid1.TextMatrix(y_T%, x_T% - 1) = ""
End Sub
  
  
' <<< [  Метод Гаусса  ] >>>
' Очень полезная процедура т.к. легко
' переводится с языка на язык
  
Public Sub Gauss_Math()
 Dim xx%, yy%, Minimal_Razmer%, Try_Find_Stroka%
 Dim Resheno_OK%
  
  ' Атрибуты введённой матрыцы
 Call GetMatrixAttr
  
  ' Цикл копирования в память матрицы
  ' Сохраним первоначальную матрицу
  For yy% = 1 To MatrPoY%: For xx% = 1 To MatrPoX%
  Matrix#(xx%, yy%) = TblXY#(xx%, yy%): Next: Next
   
  ' Проверка размера матрицы и введённых переменных
  Minimal_Razmer% = MatrPoX% - 1
  If MatrPoY% > Minimal_Razmer% Then Minimal_Razmer% = MatrPoY%
   
  If Minimal_Razmer% > 2 Then Form1.HScroll2.Value = Minimal_Razmer%
  If MatrPoX% < MatrPoY% Then
   Call ClearConsole
   Call OutConsole("Матрица задана неправильно !!!")
   Call OutConsole("Введите недостающие столбцы...")
   Exit Sub
  End If
  
  'Call Stroka_Del(1, 1)  'Вызов процедуры деления на строку
  'Form1.Print Stolbec_Bazis%(1, 1) 'Процедура проверки базиса
  'Call Zamena_Strok(1, 2)   ' Перестановка строк
  'Form1.Print Detect_Best_Stroka%(3, 3)
  'Call Stroka_Del(1, 1)
  ' Exit Sub
    
   Call OutConsole(" _-^-^-^-  Р Е Ш Е Н И Е  -^-^-^-_")
   For i% = 1 To MatrPoX% - 1
    If TblXY#(i%, i%) <> 0 Then
     Call Stroka_Del(i%, i%)   'Делим строку и вычитаем её из др.
     Call OutConsole(" Приводим переменную X" + LTrim$(Str$(i%)) + " к базисной переменной")
     Call Matrix_To_Console
    Else
     Try_Find_Stroka% = Detect_Best_Stroka%(i%, i%)
      If Try_Find_Stroka% = -1 Then
       Call OutConsole("Дальше решать нельзя !!!")
        Exit For
      Else
       Call Zamena_Strok(i%, Try_Find_Stroka%)
       Call OutConsole("Переставляем строки с номерами " + Str$(i%) + "и" + Str$(Try_Find_Stroka%))
       Call Stroka_Del(i%, i%)   'Делим строку и вычитаем её из др.
       Call OutConsole(" Приводим переменную X" + LTrim$(Str$(i%)) + " к базисной переменной")
      End If
    End If
   Next
   
     ' Проверка: Решена ли система...
     Resheno_OK% = 1
     For u% = 1 To MatrPoX% - 1
      If Stolbec_Bazis%(u%, u%) <> 3 Then
       Resheno_OK% = 0: Exit For
      End If
     Next u%
   
   If Resheno_OK% = 1 Then
    Call OutConsole("Система успешно решена методом Жордана Гаусса !!!")
   Else
    Call OutConsole("Система не решена полностью, найдено частное решение !!!")
   End If
  
End Sub
  
' Деление строки y% на x% элемент и
' вычитание из др строк строки y%
Private Sub Stroka_Del(x%, y%)
 Dim xx%, yy%, Minus_Stroka#, Umnojenie#
 DelitelStroki# = TblXY#(x%, y%)
 If DelitelStroki# = 0 Then DelitelNull% = 1: Exit Sub
 DelitelNull% = 0
  
 For xx% = 1 To MatrPoX%
 Call SetTblXY(xx%, y%, TblXY#(xx%, y%) / DelitelStroki#): Next
  
 For yy% = 1 To MatrPoY%
  If yy% <> y% Then
   Umnojenie# = -TblXY#(x%, yy%)
  For xx% = 1 To MatrPoX%
   Minus_Stroka# = TblXY#(xx%, yy%) + TblXY#(xx%, y%) * Umnojenie#
   Call SetTblXY(xx%, yy%, Minus_Stroka#)
  Next xx%
  End If
 Next yy%
 'Form1.Print MatrPoX%, MatrPoY%
End Sub
  
' Определить является ли столбец базисом в данный момент
' частичным или полным
Private Function Stolbec_Bazis%(x%, y%)
Dim xxx%, yyy%, SummaX%, SummaY%, BAZIS%
 If x% > 0 And x% < MatrPoX% And y% > 0 And y% < MatrPoY% + 1 Then
  
 SummaX% = 0: SummaY% = 0: BAZIS% = 0
  
  ' Сканируем сумму по X
 For xxx% = 1 To MatrPoX% - 1
 SummaX% = SummaX% + TblXY#(xxx%, y%): Next
  ' Сканируем сумму по Y
 For yyy% = 1 To MatrPoY%
 SummaY% = SummaY% + TblXY#(x%, yyy%): Next
 Form1.Print SummaY%
 If TblXY#(x%, y%) = 1 And SummaX% = 1 Then BAZIS% = 1
 If TblXY#(x%, y%) = 1 And SummaY% = 1 Then BAZIS% = BAZIS% + 2
 ' 1 - базис по X , 2 - базис по Y, 3 - Базис по обеим(полный)
  
 Stolbec_Bazis% = BAZIS%
 End If
End Function
  
' Определение параметров матрицы
'
Private Sub GetMatrixAttr()
Dim xx%, yy%
  MatrPoX% = 0: MatrPoY% = 0
  For xx% = 1 To Form1.MSFlexGrid1.Cols
   For yy% = 1 To Form1.MSFlexGrid1.Rows - 1
    If TblXY#(xx%, yy%) <> 0 Then
     If xx% > MatrPoX% Then MatrPoX% = xx%
     If yy% > MatrPoY% Then MatrPoY% = yy%
    End If
  Next: Next
  ' Доработка матрицы
   For yy% = 1 To Form1.MSFlexGrid1.Rows - 1
   For xx% = 1 To Form1.MSFlexGrid1.Cols
    If xx% <= MatrPoX% And yy% <= MatrPoY% Then
    Call SetTblXY(xx%, yy%, TblXY#(xx%, yy%))
    Else: Call ClrTblXY(xx%, yy%)
    End If
   Next: Next
End Sub
  
' Перестановка двух строк
'
Private Sub Zamena_Strok(StrokaY1%, StrokaY2%)
 Dim SwpPRM#, xx%
 For xx% = 1 To MatrPoX%
   SwpPRM# = TblXY#(xx%, StrokaY1%)
   Call SetTblXY(xx%, StrokaY1%, TblXY#(xx%, StrokaY2%))
   Call SetTblXY(xx%, StrokaY2%, SwpPRM#)
 Next xx%
End Sub
  
' Нахождение ненулевого элемента столбца
' сканируя вниз
Private Function Detect_Best_Stroka%(StolbecN%, BeginY%)
 Dim yy%, Nashel%
 Nashel% = 0
 For yy% = BeginY% To MatrPoY%
   If TblXY#(StolbecN%, yy%) <> 0 Then
   Nashel% = 1: Detect_Best_Stroka% = yy%: Exit Function
   End If
 Next
 If Nashel% = 0 Then Detect_Best_Stroka% = -1
End Function

Похожие записи/страницы:

Leave a Comment